home *** CD-ROM | disk | FTP | other *** search
/ isnet Internet / Isnet Internet CD.iso / prog / hiz / 09 / 09.exe / adynware.exe / perl / lib / Text / ParseWords.pm < prev    next >
Encoding:
Perl POD Document  |  1999-12-28  |  3.1 KB  |  151 lines
  1. package Text::ParseWords;
  2.  
  3. require 5.000;
  4. use Carp;
  5.  
  6. require AutoLoader;
  7. *AUTOLOAD = \&AutoLoader::AUTOLOAD;
  8.  
  9. require Exporter;
  10. @ISA = qw(Exporter);
  11. @EXPORT = qw(shellwords quotewords);
  12. @EXPORT_OK = qw(old_shellwords);
  13.  
  14. =head1 NAME
  15.  
  16. Text::ParseWords - parse text into an array of tokens
  17.  
  18. =head1 SYNOPSIS
  19.  
  20.   use Text::ParseWords;
  21.   @words = "ewords($delim, $keep, @lines);
  22.   @words = &shellwords(@lines);
  23.   @words = &old_shellwords(@lines);
  24.  
  25. =head1 DESCRIPTION
  26.  
  27. "ewords() accepts a delimiter (which can be a regular expression)
  28. and a list of lines and then breaks those lines up into a list of
  29. words ignoring delimiters that appear inside quotes.
  30.  
  31. The $keep argument is a boolean flag.  If true, the quotes are kept
  32. with each word, otherwise quotes are stripped in the splitting process.
  33. $keep also defines whether unprotected backslashes are retained.
  34.  
  35. A &shellwords() replacement is included to demonstrate the new package.
  36. This version differs from the original in that it will _NOT_ default
  37. to using $_ if no arguments are given.  I personally find the old behavior
  38. to be a mis-feature.
  39.  
  40. "ewords() works by simply jamming all of @lines into a single
  41. string in $_ and then pulling off words a bit at a time until $_
  42. is exhausted.
  43.  
  44. =head1 AUTHORS
  45.  
  46. Hal Pomeranz (pomeranz@netcom.com), 23 March 1994
  47.  
  48. Basically an update and generalization of the old shellwords.pl.
  49. Much code shamelessly stolen from the old version (author unknown).
  50.  
  51. =cut
  52.  
  53. 1;
  54. __END__
  55.  
  56. sub shellwords {
  57.     local(@lines) = @_;
  58.     $lines[$#lines] =~ s/\s+$//;
  59.     "ewords('\s+', 0, @lines);
  60. }
  61.  
  62.  
  63.  
  64. sub quotewords {
  65.  
  66.  
  67.     my ($delim, $keep, @lines) = @_;
  68.     my (@words, $snippet, $field);
  69.  
  70.     local $_ = join ('', @lines);
  71.  
  72.     while (length) {
  73.     $field = '';
  74.  
  75.     for (;;) {
  76.         $snippet = '';
  77.  
  78.         if (s/^"([^"\\]*(\\.[^"\\]*)*)"//) {
  79.         $snippet = $1;
  80.         $snippet = qq|"$snippet"| if $keep;
  81.         }
  82.         elsif (s/^'([^'\\]*(\\.[^'\\]*)*)'//) {
  83.         $snippet = $1;
  84.         $snippet = "'$snippet'" if $keep;
  85.         }
  86.         elsif (/^["']/) {
  87.         croak 'Unmatched quote';
  88.         }
  89.         elsif (s/^\\(.)//) {
  90.         $snippet = $1;
  91.         $snippet = "\\$snippet" if $keep;
  92.         }
  93.         elsif (!length || s/^$delim//) {
  94.            last;
  95.         }
  96.         else {
  97.         while (length && !(/^$delim/ || /^['"\\]/)) {
  98.            $snippet .= substr ($_, 0, 1);
  99.            substr($_, 0, 1) = '';
  100.         }
  101.         }
  102.  
  103.         $field .= $snippet;
  104.     }
  105.  
  106.     push @words, $field;
  107.     }
  108.  
  109.     return @words;
  110. }
  111.  
  112.  
  113. sub old_shellwords {
  114.  
  115.  
  116.     local($_) = join('', @_);
  117.     my(@words,$snippet,$field);
  118.  
  119.     s/^\s+//;
  120.     while ($_ ne '') {
  121.     $field = '';
  122.     for (;;) {
  123.         if (s/^"(([^"\\]|\\.)*)"//) {
  124.         ($snippet = $1) =~ s#\\(.)#$1#g;
  125.         }
  126.         elsif (/^"/) {
  127.         croak "Unmatched double quote: $_";
  128.         }
  129.         elsif (s/^'(([^'\\]|\\.)*)'//) {
  130.         ($snippet = $1) =~ s#\\(.)#$1#g;
  131.         }
  132.         elsif (/^'/) {
  133.         croak "Unmatched single quote: $_";
  134.         }
  135.         elsif (s/^\\(.)//) {
  136.         $snippet = $1;
  137.         }
  138.         elsif (s/^([^\s\\'"]+)//) {
  139.         $snippet = $1;
  140.         }
  141.         else {
  142.         s/^\s+//;
  143.         last;
  144.         }
  145.         $field .= $snippet;
  146.     }
  147.     push(@words, $field);
  148.     }
  149.     @words;
  150. }
  151.